home *** CD-ROM | disk | FTP | other *** search
/ SGI Desktop Special Edition 1.1 / SGI Desktop Special Edition 1.1.iso / dist / SoftWindows2.idb / usr / lib / SoftWindows2 / cgi-bin / lib.pl.z / lib.pl
Encoding:
Perl Script  |  1995-11-13  |  3.7 KB  |  154 lines
  1. #!/usr/local/bin/perl -- -*- C -*-
  2.  
  3. # Perl Routines to Manipulate CGI input
  4.  
  5. #  Sample
  6. # require "cgi-lib.pl";
  7. # if (&ReadParse(*input)) {
  8. #    print &PrintHeader, &PrintVariables(%input);
  9. # } else {
  10. #   print &PrintHeader,'<form><input type="submit">Data: <input name="myfield">';
  11. #}
  12.  
  13. # ReadParse
  14. # Reads in GET or POST data, converts it to unescaped text, and puts
  15. # one key=value in each member of the list "@in"
  16. # Also creates key/value pairs in %in, using '\0' to separate multiple
  17. # selections
  18.  
  19. # Returns TRUE if there was input, FALSE if there was no input 
  20. # UNDEF may be used in the future to indicate some failure.
  21.  
  22. # Now that cgi scripts can be put in the normal file space, it is useful
  23. # to combine both the form and the script in one place.  If no parameters
  24. # are given (i.e., ReadParse returns FALSE), then a form could be output.
  25.  
  26. # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
  27. # information is stored there, rather than in $in, @in, and %in.
  28.  
  29. sub ReadParse {
  30.   local (*in) = @_ if @_;
  31.   local ($i, $key, $val);
  32.  
  33.   # Read in text
  34.   if (&MethGet) {
  35.     $in = $ENV{'QUERY_STRING'};
  36.   } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
  37.     read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  38.   }
  39.  
  40.   @in = split(/&/,$in);
  41.  
  42.   foreach $i (0 .. $#in) {
  43.     # Convert plus's to spaces
  44.     $in[$i] =~ s/\+/ /g;
  45.  
  46.     # Split into key and value.  
  47.     ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  48.  
  49.     # Convert %XX from hex numbers to alphanumeric
  50.     $key =~ s/%(..)/pack("c",hex($1))/ge;
  51.     $val =~ s/%(..)/pack("c",hex($1))/ge;
  52.  
  53.     # Associate key and value
  54.     $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  55.     $in{$key} .= $val;
  56.  
  57.   }
  58.  
  59.   return length($in); 
  60. }
  61.  
  62.  
  63. # PrintHeader
  64. # Returns the magic line which tells WWW that we're an HTML document
  65.  
  66. sub PrintHeader {
  67.   return "Content-type: text/html\n\n";
  68. }
  69.  
  70.  
  71. # MethGet
  72. # Return true if this cgi call was using the GET request, false otherwise
  73.  
  74. sub MethGet {
  75.   return ($ENV{'REQUEST_METHOD'} eq "GET");
  76. }
  77.  
  78. # MyURL
  79. # Returns a URL to the script
  80. sub MyURL  {
  81.   return  'http://' . $ENV{'SERVER_NAME'} .  $ENV{'SCRIPT_NAME'};
  82. }
  83.  
  84. # CgiError
  85. # Prints out an error message which which containes appropriate headers,
  86. # markup, etcetera.
  87. # Parameters:
  88. #  If no parameters, gives a generic error message
  89. #  Otherwise, the first parameter will be the title and the rest will 
  90. #  be given as different paragraphs of the body
  91.  
  92. sub CgiError {
  93.   local (@msg) = @_;
  94.   local ($i,$name);
  95.  
  96.   if (!@msg) {
  97.     $name = &MyURL;
  98.     @msg = ("Error: script $name encountered fatal error");
  99.   };
  100.  
  101.   print &PrintHeader;
  102.   print "<html><head><title>$msg[0]</title></head>\n";
  103.   print "<body><h1>$msg[0]</h1>\n";
  104.   foreach $i (1 .. $#msg) {
  105.     print "<p>$msg[$i]</p>\n";
  106.   }
  107.   print "</body></html>\n";
  108. }
  109.  
  110. # PrintVariables
  111. # Nicely formats variables in an associative array passed as a parameter
  112. # And returns the HTML string.
  113.  
  114. sub PrintVariables {
  115.   local (%in) = @_;
  116.   local ($old, $out, $output);
  117.   $old = $*;  $* =1;
  118.   $output .=  "<DL COMPACT>";
  119.   foreach $key (sort keys(%in)) {
  120.     foreach (split("\0", $in{$key})) {
  121.       ($out = $_) =~ s/\n/<BR>/g;
  122.       $output .=  "<DT><B>$key</B><DD><I>$out</I><BR>";
  123.     }
  124.   }
  125.   $output .=  "</DL>";
  126.   $* = $old;
  127.  
  128.   return $output;
  129. }
  130.  
  131. # PrintVariablesShort
  132. # Nicely formats variables in an associative array passed as a parameter
  133. # Using one line per pair (unless value is multiline)
  134. # And returns the HTML string.
  135.  
  136.  
  137. sub PrintVariablesShort {
  138.   local (%in) = @_;
  139.   local ($old, $out, $output);
  140.   $old = $*;  $* =1;
  141.   foreach $key (sort keys(%in)) {
  142.     foreach (split("\0", $in{$key})) {
  143.       ($out = $_) =~ s/\n/<BR>/g;
  144.       $output .= "<B>$key</B> is <I>$out</I><BR>";
  145.     }
  146.   }
  147.   $* = $old;
  148.  
  149.   return $output;
  150. }
  151.  
  152. 1; #return true 
  153.  
  154.